home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEBITKIL.BAS < prev    next >
BASIC Source File  |  1987-01-22  |  12KB  |  281 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Delete a key from the index - introduction'
  4. '
  5. '  Major modification(s)
  6. '
  7. '     1) Reallocation of the key to the system.
  8. '     2) Relinkage of the keys for the correct sequencing.
  9. '
  10. '                 ==> still needed <==
  11. '
  12. '     3) Balance checking of the keys during deletion.
  13. '     4) Version to allocate 32 bit record pointers.
  14. '
  15. '  Modifications on 7th January, 1987.
  16. '
  17. '  More modifications on 10th January, 1987.
  18. '
  19. '  More modifications on 22nd January, 1987.
  20. '
  21. '  Taken out logical expressions. NOT and AND seem to behave in a
  22. '  different manner than expected. Use instead, math logical expressions.
  23. '
  24. '  Deleting keys with parents seems to be fine. The problem is deleting
  25. '  keys where their location is record 1 in the file. To do this correctly,
  26. '  a key needs to be moved from the left side of the index and placed in
  27. '  record 1. This key then needs to have it's childrens' parents' pointers
  28. '  reallocated, and then the previous position for this record placed on the
  29. '  deletion stack.
  30. '
  31. '  The above problem reared it's head on january 22nd. This time, when a key
  32. '  (which was in record 1) was deleted with only LEFT NODE children, the
  33. '  whole index would 'vanish' !
  34. '
  35. '  This is indeed a bug
  36. '
  37. '  This also happens to keys with RIGHT children ! Oh No !
  38. '
  39. '  (c) Copyright 1986, 1987 Roy Barrow
  40. '
  41. '
  42. '  Key      =  1
  43. '  Left     =  2
  44. '  Right    =  3
  45. '  Parent   =  4
  46. '  Master   =  5
  47. '  Delete   =  6
  48.  
  49. rem $include:'AESHARED.BAS'            
  50.     
  51. sub bit.kill(fl%,ky$,mrec%,success%) static
  52.  
  53.         if mrec%<1 then
  54.             goto badkey
  55.         end if
  56.  
  57.         if success%<1 then
  58.             goto badkey
  59.         end if
  60.  
  61.         get #fl%,success%                         ' key to delete
  62.  
  63.         dk$=xk$(fl%,1%)                           ' key
  64.         d.s%=success%                             ' position in file
  65.         d.l%=cvi(xk$(fl%,2%))                     ' left pointer
  66.         d.r%=cvi(xk$(fl%,3%))                     ' right pointer
  67.         d.p%=cvi(xk$(fl%,4%))                     ' parent pointer
  68.         d.m%=cvi(xk$(fl%,5%))                     ' pointer to ACTUAL record
  69.         d.d%=cvi(xk$(fl%,6%))                     ' pointer to next deleted
  70.  
  71.         if (d.p%<>0%) then                        ' there IS a parent
  72.  
  73. rem $subtitle:'There is a parent and a left child'
  74. rem $page
  75.             if (d.l%<>0%) and (d.r%=0%) then       ' left ONLY
  76.                 get #fl%,d.p%                       ' get the parent
  77.                 if cvi(xk$(fl%,2%))=d.s% then       ' yes, link to the left
  78.                     side%=2%
  79.                 else
  80.                     side%=3%                         ' otherwise, right
  81.                 end if
  82.                 lset xk$(fl%,side%)=mki$(d.l%)      ' change the link
  83.                 put #fl%,d.p%                       ' write it back
  84.                 get #fl%,d.l%                       ' get the kid
  85.                 lset xk$(fl%,4%)=mki$(d.p%)         ' relink the child
  86.                 put #fl%,d.l%                       ' write it back
  87.                 gosub init.key.rec                  ' init the record
  88.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  89.                 put #fl%,d.s%                       ' write it away
  90.                 xh%(fl%,4%)=d.s%                    ' new deleted lifo rec
  91.             end if
  92. rem $subtitle:'There is a parent and a right child'
  93. rem $page
  94.             if (d.r%<>0%) and (d.l%=0%) then       ' right ONLY
  95.                 get #fl%,d.p%                       ' get the parent
  96.                 if cvi(xk$(fl%,2%))=d.s% then       ' yes, link to the left
  97.                     side%=2%
  98.                 else
  99.                     side%=3%                         ' otherwise, right
  100.                 end if
  101.                 lset xk$(fl%,side%)=mki$(d.r%)      ' change the link
  102.                 put #fl%,d.p%                       ' write it back
  103.                 get #fl%,d.r%                       ' get the kid
  104.                 lset xk$(fl%,4%)=mki$(d.p%)         ' relink the child
  105.                 put #fl%,d.r%                       ' write it back
  106.                 gosub init.key.rec                  ' init the record
  107.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  108.                 put #fl%,d.s%                       ' write it away
  109.                 xh%(fl%,4%)=d.s%                    ' new deleted lifo rec
  110.             end if
  111. rem $subtitle:'There is a parent , but no children'
  112. rem $page
  113.             if ((d.l%=0%) and (d.r%=0%)) then      ' NO children
  114.                 get #fl%,d.p%                       ' get the parent
  115.                 if cvi(xk$(fl%,2%))=d.s% then       ' yes, link to the left
  116.                     side%=2%
  117.                 else
  118.                     side%=3%                         ' otherwise, right
  119.                 end if
  120.                 lset xk$(fl%,side%)=mki$(0%)        ' change the link
  121.                 put #fl%,d.p%                       ' write it back
  122.                 gosub init.key.rec                  ' init the record
  123.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  124.                 put #fl%,d.s%                       ' write it away
  125.                 xh%(fl%,4%)=d.s%                    ' new deleted lifo rec
  126.             end if
  127. rem $subtitle:'There is a parent and both left & right children'
  128. rem $page
  129.             if (d.l%<>0%) and (d.r%<>0%) then      ' Yup, two kids
  130.                 get #fl%,d.l%                       ' get the left
  131.                 lset xk$(fl%,4%)=mki$(d.p%)         ' give a new parent
  132.                 put #fl%,d.l%                       ' write it back
  133.                 pnh%=d.l%                           ' last key so far
  134.                 nh%=cvi(xk$(fl%,3%))                ' right key
  135.                 while nh%<>0%                       ' keep getting
  136.                     get #fl%,nh%                     ' get right
  137.                     pnh%=nh%                         ' last key so far
  138.                     nh%=cvi(xk$(fl%,3%))             ' right key
  139.                 wend
  140.                 lset xk$(fl%,3%)=mki$(d.r%)         ' link deleted's right to this
  141.                 put #fl%,pnh%                       ' write this one back
  142.                 get #fl%,d.r%                       ' get the right one
  143.                 lset xk$(fl%,4%)=mki$(pnh%)         ' set the new parent
  144.                 put #fl%,d.r%                       ' write it back
  145.                 get #fl%,d.p%                       ' fetch the parent
  146.                 if cvi(xk$(fl%,2%))=d.s% then       ' yes, link to the left
  147.                     side%=2%
  148.                 else
  149.                     side%=3%                         ' otherwise, right
  150.                 end if
  151.                 lset xk$(fl%,side%)=mki$(d.l%)      ' change the link
  152.                 put #fl%,d.p%                       ' write it back
  153.                 gosub init.key.rec                  ' init the record
  154.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  155.                 put #fl%,d.s%                       ' write it away
  156.                 xh%(fl%,4%)=d.s%                    ' new deleted lifo rec
  157.             end if
  158.  
  159.         elseif (d.s%=1%) then                     ' NO PARENT
  160. rem $subtitle:'No parent, and there is a left child'
  161. rem $page
  162.             if (d.l%<>0%) and (d.r%=0%) then       ' left ONLY
  163.                 get #fl%,d.l%                       ' get left
  164.                 lrec%=cvi(xk$(fl%,2%))              ' the left grandchild
  165.                 rrec%=cvi(xk$(fl%,3%))              ' the right grandchild
  166.                 lset xk$(fl%,4%)=mki$(0%)           ' no parent for this
  167.                 put #fl%,1%                         ' write to 1
  168.                 if (lrec%<>0%) then                 ' yes, theres a left gc
  169.                     get #fl%,lrec%                   ' get the left grandchild
  170.                     lset xk$(fl%,4%)=mki$(1%)        ' new parent
  171.                     put #fl%,lrec%                   ' put this record away
  172.                 end if
  173.                 if (rrec%<>0%) then                 ' yes, theres a right gc
  174.                     get #fl%,rrec%                   ' get the right grandchild
  175.                     lset xk$(fl%,4%)=mki$(1%)        ' new parent
  176.                     put #fl%,rrec%                   ' put this record away
  177.                 end if
  178.                 gosub init.key.rec                  ' init the record
  179.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  180.                 put #fl%,d.l%                       ' write it away
  181.                 xh%(fl%,4%)=d.l%                    ' new deleted lifo rec
  182.             end if
  183. rem $subtitle:'No parent, and there is a right child'
  184. rem $page
  185.             if (d.r%<>0%) and (d.l%=0%) then       ' right ONLY
  186.                 get #fl%,d.r%                       ' get right
  187.                 lrec%=cvi(xk$(fl%,2%))              ' the left grandchild
  188.                 rrec%=cvi(xk$(fl%,3%))              ' the right grandchild
  189.                 lset xk$(fl%,4%)=mki$(0%)           ' no parent for this
  190.                 put #fl%,1%                         ' write to 1
  191.                 if (lrec%<>0%) then                 ' yes, theres a left gc
  192.                     get #fl%,lrec%                   ' get the left grandchild
  193.                     lset xk$(fl%,4%)=mki$(1%)        ' new parent
  194.                     put #fl%,lrec%                   ' put this record away
  195.                 end if
  196.                 if (rrec%<>0%) then                 ' yes, theres a right gc
  197.                     get #fl%,rrec%                   ' get the right grandchild
  198.                     lset xk$(fl%,4%)=mki$(1%)        ' new parent
  199.                     put #fl%,rrec%                   ' put this record away
  200.                 end if
  201.  
  202.                 gosub init.key.rec                  ' init the record
  203.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  204.                 put #fl%,d.r%                       ' write it away
  205.                 xh%(fl%,4%)=d.r%                    ' new deleted lifo rec
  206.             end if
  207. rem $subtitle:'No parent and no children'
  208. rem $page
  209.             if ((d.l%=0%) and (d.r%=0%)) then      ' NO children, NO parents, lonely!
  210.                                                                 ' Just in case index is large ...
  211.                 close #fl%                          ' close the index
  212.                 hn$=idx.nam$(fl%)                   ' Name of the index
  213.                 kl%=xh%(fl%,1%)                     ' Key Length
  214.  
  215.                 call Bit.Creatq(fl%,hn$,kl%)        ' Re-create the file
  216.                 if aesb.fatal% then                 ' Fatal error opening index
  217.                     call ae.error("BITKIL/BITCRE(RE)")
  218.                 end if
  219.                 call Bit.Open(fl%,hn$)              ' Ya got it, just create it again
  220.             end if
  221. rem $subtitle:'No parent, but both left and right children'
  222. rem $page
  223.             if (d.l%<>0%) and (d.r%<>0%) then      ' Yup, two kids
  224.                 get #fl%,d.l%                       ' get the left
  225.                 lrec%=cvi(xk$(fl%,2%))              ' the left grandchild
  226.                 rrec%=cvi(xk$(fl%,3%))              ' the right grandchild
  227.                 lset xk$(fl%,4%)=mki$(0%)           ' no parent for this
  228.                 put #fl%,1%                         ' write to 1
  229.                 if (lrec%<>0%) then                 ' yes, theres a left gc
  230.                     get #fl%,lrec%                   ' get the left grandchild
  231.                     lset xk$(fl%,4%)=mki$(1%)        ' new parent
  232.                     put #fl%,lrec%                   ' put this record away
  233.                 end if
  234.                 if (rrec%<>0%) then                 ' yes, theres a right gc
  235.                     get #fl%,rrec%                   ' get the right grandchild
  236.                     lset xk$(fl%,4%)=mki$(1%)        ' new parent
  237.                     put #fl%,rrec%                   ' put this record away
  238.                 end if
  239.                 get #fl%,1%                         ' get left again
  240.                                                                 ' thats where the new record is now
  241.                 pnh%=1%                             ' last key so far
  242.                 nh%=cvi(xk$(fl%,3%))                ' right key
  243.                 while nh%<>0%                       ' keep getting
  244.                     get #fl%,nh%                     ' get right
  245.                     pnh%=nh%                         ' last key so far
  246.                     nh%=cvi(xk$(fl%,3%))             ' right key
  247.                 wend
  248.                 lset xk$(fl%,3%)=mki$(d.r%)         ' link deleted's right to this
  249.                 put #fl%,pnh%                       ' write this one back
  250.                 get #fl%,d.r%                       ' get the right one
  251.                 lset xk$(fl%,4%)=mki$(pnh%)         ' set the new parent
  252.                 put #fl%,d.r%                       ' write it back
  253.                 gosub init.key.rec                  ' init the record
  254.                 lset xk$(fl%,6%)=mki$(xh%(fl%,4%))  ' allocate on stack
  255.                 put #fl%,d.l%                       ' write it away
  256.                 xh%(fl%,4%)=d.l%                    ' new deleted lifo rec
  257.             end if
  258.  
  259.         end if
  260.  
  261.         goto goodkey
  262. rem $subtitle:'Initialize a key to blanks'
  263. rem $page
  264. init.key.rec:                                ' Initialize the key
  265.         for j%=2% to 6%
  266.             lset xk$(fl%,j%)=mki$(0%)
  267.         next j%
  268.         lset xk$(fl%,1%)=string$(xh%(fl%,1%)+10%,0%)
  269.         xh%(fl%,2)=xh%(fl%,2)-1
  270.         return
  271.  
  272. goodkey:
  273.         success%=1
  274.         goto deleted
  275. badkey:
  276.         mrec%=0
  277.         success%=0
  278. deleted:
  279.     end sub
  280.  
  281.